home *** CD-ROM | disk | FTP | other *** search
/ ASP Advantage 1994 2nd Q2 / The Association of Shareware Professionals - The Official ASP Advantage (2nd Quarter)(1994).bin / files / progming / basicxr / amortqb.bas < prev    next >
Encoding:
BASIC Source File  |  1994-01-04  |  4.6 KB  |  155 lines
  1. 'AMORTQB.BAS       Copyright 1993 by JN Goodale
  2. 'Date: [93-12-20]
  3. '
  4. '   *** NOTE ***
  5. '   This program is included for the purpose of demonstrating BASICXR.
  6. '   The program works correctly, but may contain errors if run with
  7. '       unusual input.  The author assumes no responsibility for making
  8. '       corrections to AMORTQB.BAS!
  9. '
  10. 'Desc: Amortization of a Loan - Find Amount of Level Payment
  11. '
  12. '
  13. '      P=Principal
  14. '      R=Interest Rate
  15. '      I=Interest/Period
  16. '      N=Number of Payments (Periods)
  17. '      A=Amount of Level Payment
  18. '
  19. '
  20. '
  21. '                 P * I
  22. '        A =   --------------
  23. '                      1
  24. '              1 -  --------
  25. '                   (1+I) ^N           Where ^N is "to the Nth Power"
  26. '
  27. '.......................................................................
  28.  
  29.  
  30. DIM text$(24)
  31. '               0         1         2         3         4         5
  32. '           123456789 123456789 123456789 123456789 123456789 123456789
  33. text$(1) = "                             [ LOAN AMORTIZATION ]"
  34. text$(2) = " "
  35. text$(3) = "      Calculate a Level Loan Payment, given:"
  36. text$(4) = "          Loan Principal, nearest full $  (Max 500000)"
  37. text$(5) = "          Interest Rate per Year (Max 30.00), Full %, as in 7.75 = 7.75%"
  38. text$(6) = "          Number of months to Pay  (Max 480)"
  39. text$(7) = "                I.E. 30 Years = 360 Months"
  40. text$(8) = "                      4 Years =  48 Months"
  41. text$(9) = STRING$(80, 220)
  42. text$(10) = "      Enter Amount of PRINCIPAL:             (Q-to Quit)"
  43. text$(11) = "          Enter Interest Rate %: "
  44. text$(12) = "         Enter Number of Months: "
  45. text$(13) = " "
  46. text$(14) = "     The MONTHLY Payment on the above loan would be:  $"
  47. text$(15) = " "
  48. text$(16) = "          V-To View loan schedule"
  49. text$(17) = "          Q-To Quit"
  50. text$(18) = " "
  51. text$(19) = " "
  52. text$(20) = "                           Choice ? _"
  53. text$(21) = " "
  54. text$(22) = " "
  55. text$(23) = " "
  56. text$(24) = " "
  57. '            123456789 123456789 123456789 123456789 123456789 123456789
  58. '                0         1         2         3         4         5
  59.  
  60. DIM heading$(3)
  61. heading$(1) = "              [ Loan Amortization Table ]"
  62. heading$(2) = "     Payment #   Balance      Interest     Principal"
  63. heading$(3) = " "
  64.  
  65. E0$ = "#######": E2$ = "#######.##": EI$ = "####"
  66.  
  67. StartProcess:
  68. GetPrincipal:
  69.     CLS
  70.     FOR i = 1 TO 10: PRINT text$(i): NEXT i
  71.     LOCATE 10, 34: LINE INPUT Principal$
  72.     IF (Principal$ = "Q") OR (Principal$ = "q") THEN GOTO EndProgram
  73.     n = INSTR(Principal$, ".")
  74.     IF n THEN Principal$ = LEFT$(Principal$, n - 1)
  75.     Principal = VAL(Principal$)
  76.     IF Principal < 1 THEN GOTO StartProcess
  77.     IF Principal > 500000 THEN GOTO StartProcess
  78.     LOCATE 11, 1: PRINT text$(11)
  79.  
  80. GetInterest:
  81.     LOCATE 11, 35: LINE INPUT InterestRate$
  82.     InterestRate = VAL(InterestRate$) / 1200
  83.     IF (InterestRate < 0) OR (InterestRate > 30 / 1200) THEN
  84.         LOCATE 11, 35
  85.         PRINT SPACE$(10);
  86.         GOTO GetInterest
  87.     END IF
  88.     LOCATE 12, 1: PRINT text$(12)
  89.  
  90. GetMonthsToPay:
  91.     LOCATE 12, 35: LINE INPUT Months$
  92.     Months% = VAL(Months$) \ 1
  93.     Months = Months%
  94.     IF (Months% < 1) OR (Months% > 480) THEN
  95.         LOCATE 12, 35
  96.         PRINT SPACE$(10);
  97.         GOTO GetMonthsToPay
  98.     END IF
  99.  
  100. CalculateAmount:
  101.     x = (1 + InterestRate) ^ Months%
  102.     y = 1 / x
  103.     z = 1 - y
  104.     Amount = (Principal * InterestRate) / z
  105.  
  106. PrintAmount:
  107.     LOCATE 14, 1
  108.     FOR i = 14 TO 20: PRINT text$(i): NEXT i
  109.     LOCATE 14, 57: PRINT USING E2$; (Amount);
  110.     LOCATE 20, 37
  111.  
  112. GetChoice:
  113.     k$ = INKEY$
  114.     IF k$ = "" THEN GOTO GetChoice
  115.     k$ = UCASE$(k$)
  116.     IF k$ = "Q" THEN GOTO EndProgram
  117.     IF k$ = "V" THEN GOSUB PrintLoanTable
  118.     GOTO StartProcess
  119.  
  120. EndProgram:
  121.     CLS
  122.     END
  123.  
  124. PrintLoanTable:
  125.     GOSUB HeadUpTableX: Balance = Principal
  126.     FOR i% = 1 TO Months%
  127.         InterestPay = Balance * InterestRate
  128.         PrincipalPay = Amount - InterestPay
  129.         Balance = Balance - PrincipalPay
  130.         Row = Row + 1
  131.         IF Row > 22 THEN GOSUB HeadUpTable
  132.         IF k$ = "Q" THEN RETURN
  133.         PRINT "          ";
  134.         PRINT USING EI$; (i%); : PRINT "   ";
  135.         PRINT USING E0$; Balance; : PRINT "    ";
  136.         PRINT USING E2$; InterestPay; : PRINT "    ";
  137.         PRINT USING E2$; PrincipalPay
  138.     NEXT i%
  139.     GOSUB HeadUpTable
  140.     RETURN
  141.  
  142. HeadUpTable:
  143.     PRINT
  144.     PRINT TAB(20); "Q-To Quit,   Any Other Key to Continue ......";
  145. GetAKey:
  146.     k$ = INKEY$
  147.     IF k$ = "" THEN GOTO GetAKey
  148.     k$ = UCASE$(k$)
  149. HeadUpTableX:
  150.     CLS
  151.     IF k$ = "Q" THEN RETURN
  152.     FOR Row = 1 TO 3: PRINT heading$(Row): NEXT Row
  153.     RETURN
  154.  
  155.